home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Format CD 49
/
Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso
/
-serious-
/
graphics
/
amicad
/
arexx
/
zoom.amicad
< prev
Wrap
Text File
|
1999-12-06
|
5KB
|
196 lines
/* Zoom.AmiCAD, agrandissement ou réduction d'un
ensemble d'objets à un rapport déterminé.
$VER: zoom 1.0 (© R.Florac, 22/05/99) */
options results /* indispensable pour récupérer le résultat des macros */
signal on error /* pour l'interception des erreurs */
signal on syntax
'ASKNUM("Rapport d''agrandissement horizontal",100)'
rh=result
if result="" then exit
'ASKNUM("Rapport d''agrandissement vertical",'rh%1')'
rv=result
if result="" then exit
'COL(0)'; x0=result
'LINE(0)'; y0=result
x0=(x0%10)*10
y0=(y0%10)*10
'WWIDTH(-1)'; lt=result
'WIDTH(0)'; l=result
if prop(l,rh)+x0>lt then do
'MESSAGE("Pas assez de place"+CHR(10)+"pour réaliser l''opération"+CHR(10)+"(Débordement horizontal)")'
exit
end
'WHEIGHT(-1)'; ht=result
'HEIGHT(0)'; h=result
if prop(h,rv)+y0>ht then do
'MESSAGE("Pas assez de place"+CHR(10)+"pour réaliser l''opération"+CHR(10)+"(Débordement vertical)")'
exit
end
'FIRSTSEL'; o=result
if o=0 then exit
'SAVEALL(-1)'
do while o>0
'COL('o')'; xo=result
'LINE('o')'; yo=result
'TYPE('o')'
select
when result=1 | result=4 | result=5 | result=6 | result=7 | result=11 | result=12 | result=23 then do
'HSCALE('o')'; eh=prop(result,rh)
'VSCALE('o')'; ev=prop(result,rv)
'SETSCALE('o','eh','ev')'
xg=prop(xo-x0,rh)
yh=prop(yo-y0,rv)
'MOVE('o','x0-xo+xg','y0-yo+yh')'
end
when result=2 then do /* ligne */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'DELETE('o'):DRAWMODE(1):DRAW('xg','yh','xd','yb')'
o=o-1
end
when result=3 then do /* Arc */
'COORDS('o')'
parse var result xo ',' yo ',' rah ',' rav ',' ad ',' af
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
rah=prop(rah,rh)
rav=prop(rav,rv)
'M__=PENWIDTH('o',-1):DELETE('o'):DRAWMODE(-M__):ARC('xg','yh','rah','rav','ad','af')'
o=o-1
end
when result=8 then do /* pointillés */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'DELETE('o'):DRAWMODE(0):DRAW('xg','yh','xd','yb')'
o=o-1
end
when result=15 then do /* ligne double */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'DELETE('o'):DRAWMODE(2):DRAW('xg','yh','xd','yb')'
o=o-1
end
when result=9 then do /* bus */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'DELETE('o'):DRAWMODE(3):DRAW('xg','yh','xd','yb')'
o=o-1
end
when result=10 then do /* ellipse */
'COORDS('o')'
parse var result xo ',' yo ',' rah ',' rav
xg=prop(xo-x0,rh)
yh=prop(yo-y0,rv)
rah=prop(rah,rh)
rav=prop(rav,rv)
'DELETE('o'):SETFILL(0):ELLIPSE('x0+xg','y0+yh','rah','rav')'
o=o-1
end
when result=21 then do /* ligne spéciale */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'M__=PENWIDTH('o',-1):DELETE('o'):DRAWMODE(-M__):DRAW('xg','yh','xd','yb')'
o=o-1
end
when result=22 then do /* boîte */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'M__=PENWIDTH('o',-1):DELETE('o'):SETFILL(0):DRAWMODE(-M__):BOX('xg','yh','xd','yb')'
o=o-1
end
when result=24 then do /* boîte pleine */
'COORDS('o')'
parse var result xo ',' yo ',' xf ',' yf
xg=x0+prop(xo-x0,rh)
yh=y0+prop(yo-y0,rv)
xd=x0+prop(xf-x0,rh)
yb=y0+prop(yf-y0,rv)
'DELETE('o'):SETFILL(1):BOX('xg','yh','xd','yb')'
o=o-1
end
when result=25 then do /* ellipse pleine */
'COORDS('o')'
parse var result xo ',' yo ',' rah ',' rav
xg=prop(xo-x0,rh)
yh=prop(yo-y0,rv)
rah=prop(rah,rh)
rav=prop(rav,rv)
'DELETE('o'):SETFILL(1):ELLIPSE('x0+xg','y0+yh','rah','rav')'
o=o-1
end
when result=26 then do /* triangle */
'COORDS('o')'
parse var result xo ',' yo ',' x1 ',' y1 ',' x2 ',' y2
xg=prop(xo-x0,rh)
yh=prop(yo-y0,rv)
x1=prop(x1-x0,rh)
y1=prop(y1-y0,rv)
x2=prop(x2-x0,rh)
y2=prop(y2-y0,rv)
'M__=PENWIDTH('o',-1):DELETE('o'):SETFILL(0):DRAWMODE(-M__):TRIANGLE('x0+xg','y0+yh','x0+x1','y0+y1','x0+x2','y0+y2')'
o=o-1
end
when result=27 then do /* triangle plein */
'COORDS('o')'
parse var result xo ',' yo ',' x1 ',' y1 ',' x2 ',' y2
xg=prop(xo-x0,rh)
yh=prop(yo-y0,rv)
x1=prop(x1-x0,rh)
y1=prop(y1-y0,rv)
x2=prop(x2-x0,rh)
y2=prop(y2-y0,rv)
'DELETE('o'):SETFILL(1):TRIANGLE('x0+xg','y0+yh','x0+x1','y0+y1','x0+x2','y0+y2')'
o=o-1
end
otherwise nop
end
'NEXTSEL('o')'; o=result
end
exit
/* Calcul d'un pourcentage */
prop: procedure
parse arg v,p
return (v*p)%100
/* Traitement des erreurs, interruption du programme */
syntax:
erreur=RC
'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit
error:
'MESSAGE("Erreur en ligne 'SIGL'")'
exit